home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 November / SGI Freeware 1999 November - Disc 1.iso / dist / fw_expect.idb / usr / freeware / bin / tknewsbiff.z / tknewsbiff
Text File  |  1999-01-26  |  11KB  |  516 lines
  1. #!/usr/freeware/bin/expectk -f
  2.  
  3. # Name: tknewsbiff
  4. # Author: Don Libes
  5. # Version: 1.2b
  6. # Written: January 1, 1994
  7.  
  8. # Description: When unread news appears in your favorite groups, pop up
  9. # a little window describing which newsgroups and how many articles.
  10. # Go away when articles are no longer unread.
  11. # Optionally, run a UNIX program (to play a sound, read news, etc.)
  12.  
  13. # Default config file in ~/.tknewsbiff[-host]
  14.  
  15. # These two procedures are needed because Tk provides no command to undo
  16. # the "wm unmap" command.  You must remember whether it was iconic or not.
  17. # PUBLIC
  18. proc unmapwindow {} {
  19.     global _window_open
  20.  
  21.     switch [wm state .] \
  22.     iconic {
  23.         set _window_open 0
  24.     } normal {
  25.         set _window_open 1
  26.     }
  27.     wm withdraw .
  28. }
  29. unmapwindow
  30. # window state starts out as "iconic" before it is mapped, Tk bug?
  31. # make sure that when we map it, it will be open (i.e., "normal")
  32. set _window_open 1
  33.  
  34. # PUBLIC
  35. proc mapwindow {} {
  36.     global _window_open
  37.  
  38.     if $_window_open {
  39.         wm deiconify .
  40.     } else {
  41.         wm iconify .
  42.     }
  43. }
  44.  
  45. proc _abort {msg} {
  46.     global argv0
  47.  
  48.     puts "$argv0: $msg"
  49.     exit 1
  50. }
  51.  
  52. if [info exists env(DOTDIR)] {
  53.     set home $env(DOTDIR)
  54. } else {
  55.     set home [glob ~]
  56. }
  57.  
  58. set delay          60
  59. set width          27
  60. set height          10
  61. set _default_config_file  $home/.tknewsbiff
  62. set _config_file      $_default_config_file
  63. set _default_server      news
  64. set server          $_default_server
  65. set server_timeout      60
  66.  
  67. log_user 0
  68.  
  69. listbox .list -yscroll ".scrollbar set" -font "*-m-*" -setgrid 1
  70. scrollbar .scrollbar -command ".list yview" -relief raised
  71. .list config -highlightthickness 0 -border 0
  72. .scrollbar config -highlightthickness 0
  73. pack .scrollbar -side left -fill y
  74. pack .list -side left -fill both -expand 1
  75.  
  76. while {[llength $argv]>0} {
  77.     set arg [lindex $argv 0]
  78.  
  79.     if [file readable $arg] {
  80.         if 0==[string compare active [file tail $arg]] {
  81.             set active_file $arg
  82.             set argv [lrange $argv 1 end]
  83.         } else {
  84.             # must be a config file
  85.             set _config_file $arg
  86.             set argv [lrange $argv 1 end]
  87.         }
  88.     } elseif {[file readable $_config_file-$arg]} {
  89.         # maybe it's a hostname suffix for a newsrc file?
  90.         set _config_file $_default_config_file-$arg
  91.         set argv [lrange $argv 1 end]
  92.     } else {
  93.         # maybe it's just a hostname for regular newsrc file?
  94.         set server $arg
  95.         set argv [lrange $argv 1 end]
  96.     }
  97. }
  98.  
  99. proc _read_config_file {} {
  100.     global _config_file argv0 watch_list ignore_list
  101.  
  102.     # remove previous user-provided proc in case user simply
  103.     # deleted it from config file
  104.     proc user {} {}
  105.  
  106.     set watch_list {}
  107.     set ignore_list {}
  108.  
  109.     if [file exists $_config_file] {
  110.         # uplevel allows user to set global variables
  111.         if [catch {uplevel source $_config_file} msg] {
  112.             _abort "error reading $_config_file\n$msg"
  113.         }
  114.     }
  115.  
  116.     if [llength $watch_list]==0 {
  117.         watch *
  118.     }
  119. }
  120.  
  121. # PUBLIC
  122. proc watch {args} {
  123.     global watch_list
  124.  
  125.     lappend watch_list $args
  126. }
  127.  
  128. # PUBLIC
  129. proc ignore {ng} {
  130.     global ignore_list
  131.  
  132.     lappend ignore_list $ng
  133. }
  134.  
  135. # get time and server
  136. _read_config_file
  137.  
  138. # if user didn't set newsrc, try ~/.newsrc-server convention.
  139. # if that fails, fall back to just plain ~/.newsrc
  140. if ![info exists newsrc] {
  141.     set newsrc $home/.newsrc-$server
  142.     if ![file readable $newsrc] {
  143.         set newsrc $home/.newsrc
  144.         if ![file readable $newsrc] {
  145.             _abort "cannot tell what newgroups you read
  146. found neither $home/.newsrc-$server nor $home/.newsrc"
  147.         }
  148.     }
  149. }
  150.  
  151. # PRIVATE
  152. proc _read_newsrc {} {
  153.     global db newsrc
  154.  
  155.     if [catch {set file [open $newsrc]} msg] {
  156.         _abort $msg
  157.     }
  158.     while {-1 != [gets $file buf]} {
  159.         if [regexp "!" $buf] continue
  160.         if [regexp "(\[^:]*):.*\[-, ](\[0-9]+)" $buf dummy ng seen] {
  161.             set db($ng,seen) $seen
  162.         }
  163.         # only way 2nd regexp can fail is on lines
  164.         # that have a : but no number
  165.     }
  166.     close $file
  167. }
  168.  
  169. proc _unknown_host {} {
  170.     global server _default_server
  171.  
  172.     if 0==[string compare $_default_server $server] {
  173.         puts "tknewsbiff: default server <$server> is not known"
  174.     } else {
  175.         puts "tknewsbiff: server <$server> is not known"
  176.     }
  177.  
  178.     puts "Give tknewsbiff an argument - either the name of your news server
  179. or active file.  I.e.,
  180.  
  181.     tknewsbiff news.nist.gov
  182.     tknewsbiff /usr/news/lib/active
  183.  
  184. If you have a correctly defined configuration file (.tknewsbiff),
  185. an argument is not required.  See the man page for more info."
  186.     exit 1
  187. }
  188.  
  189. # read active file
  190. # PRIVATE
  191. proc _read_active {} {
  192.     global db server active_list active_file
  193.     upvar #0 server_timeout timeout
  194.  
  195.     set active_list {}
  196.  
  197.     if [info exists active_file] {
  198.         spawn -open [open $active_file]
  199.     } else {
  200.         spawn telnet $server nntp
  201.         expect {
  202.             "20*\n" {
  203.                 # should get 200 or 201
  204.             } "NNTP server*\n" {
  205.                 puts "tknewsbiff: unexpected response from server:"
  206.                 puts "$expect_out(buffer)"
  207.                 return 1
  208.             } "unknown host" {
  209.                 _unknown_host
  210.             } timeout {
  211.                 close
  212.                 wait
  213.                 return 1
  214.             } eof {
  215.                 # loadav too high probably
  216.                 wait
  217.                 return 1
  218.             }
  219.         }
  220.         exp_send "list\r"
  221.         expect "list\r\n"    ;# ignore echo of "list" command
  222.         expect -re "215\[^\n]*\n" ;# skip "Newsgroups in form" line
  223.     }
  224.     
  225.     expect {
  226.         -re "(\[^ ]*) 0*(\[^ ]+) \[^\n]*\n" {
  227.             set ng $expect_out(1,string)
  228.             set hi $expect_out(2,string)
  229.             lappend active_list $ng
  230.             set db($ng,hi) $hi
  231.             exp_continue
  232.         }
  233.         ".\r\n" close
  234.         ".\r\r\n" close
  235.         timeout close
  236.         eof
  237.     }
  238.  
  239.     wait
  240.     return 0
  241. }
  242.  
  243. # test in various ways for good newsgroups
  244. # return 1 if good, 0 if not good
  245. # PRIVATE
  246. proc _isgood {ng threshold} {
  247.     global db seen_list ignore_list
  248.  
  249.     # skip if we don't subscribe to it
  250.     if ![info exists db($ng,seen)] {return 0}
  251.  
  252.     # skip if the threshold isn't exceeded
  253.     if {$db($ng,hi) - $db($ng,seen) < $threshold} {return 0}
  254.  
  255.     # skip if it matches an ignore command
  256.     foreach igpat $ignore_list {
  257.         if [string match $igpat $ng] {return 0}
  258.     }
  259.  
  260.     # skip if we've seen it before
  261.     if [lsearch -exact $seen_list $ng]!=-1 {return 0}
  262.  
  263.     # passed all tests, so remember that we've seen it
  264.     lappend seen_list $ng
  265.     return 1
  266. }
  267.  
  268. # return 1 if not seen on previous turn
  269. # PRIVATE
  270. proc _isnew {ng} {
  271.     global previous_seen_list
  272.  
  273.     if [lsearch -exact $previous_seen_list $ng]==-1 {
  274.         return 1
  275.     } else {
  276.         return 0
  277.     }
  278. }
  279.  
  280. # schedule display of newsgroup in global variable "newsgroup"
  281. # PUBLIC
  282. proc display {} {
  283.     global display_list newsgroup
  284.  
  285.     lappend display_list $newsgroup
  286. }
  287.  
  288. # PRIVATE
  289. proc _update_ngs {} {
  290.     global watch_list active_list newsgroup
  291.  
  292.     foreach watch $watch_list {
  293.         set threshold 1
  294.         set display display
  295.         set new {}
  296.  
  297.         set ngpat [lindex $watch 0]
  298.         set watch [lrange $watch 1 end]
  299.  
  300.         while {[llength $watch] > 0} {
  301.             switch -- [lindex $watch 0] \
  302.             -threshold {
  303.                 set threshold [lindex $watch 1]
  304.                 set watch [lrange $watch 2 end]
  305.             } -display {
  306.                 set display [lindex $watch 1]
  307.                 set watch [lrange $watch 2 end]
  308.             } -new {
  309.                 set new [lindex $watch 1]
  310.                 set watch [lrange $watch 2 end]
  311.             } default {
  312.                 _abort "watch: expecting -threshold -display or -new but found: [lindex $watch 0]"
  313.             }
  314.         }
  315.  
  316.         foreach ng $active_list {
  317.             if [string match $ngpat $ng] {
  318.                 if [_isgood $ng $threshold] {
  319.                     if [llength $display] {
  320.                         set newsgroup $ng
  321.                         uplevel $display
  322.                     }
  323.                     if [_isnew $ng] {
  324.                         if [llength $new] {
  325.                             set newsgroup $ng
  326.                             uplevel $new
  327.                         }
  328.                     }
  329.                 }
  330.             }
  331.         }
  332.     }
  333. }
  334.  
  335. # initialize display
  336.  
  337. set min_reasonable_width 8
  338.  
  339. wm minsize . $min_reasonable_width 1
  340. wm maxsize . 999 999
  341. if {0 == [info exists active_file] && 
  342.     0 != [string compare $server $_default_server]} {
  343.     wm title . "news@$server"
  344.     wm iconname . "news@$server"
  345. }
  346.  
  347. # PRIVATE
  348. proc _update_window {} {
  349.     global server display_list height width min_reasonable_width
  350.  
  351.     if {0 == [llength $display_list]} {
  352.         unmapwindow
  353.         return
  354.     }
  355.  
  356.     # make height correspond to length of display_list or
  357.     # user's requested max height, whichever is smaller
  358.     
  359.     if {[llength $display_list] < $height} {
  360.         set current_height [llength $display_list]
  361.     } else {
  362.         set current_height $height
  363.     }
  364.  
  365.     # force reasonable min width
  366.     if {$width < $min_reasonable_width} {
  367.         set width $min_reasonable_width
  368.     }
  369.  
  370.     wm geometry . ${width}x$current_height
  371.     wm maxsize . 999 [llength $display_list]
  372.  
  373.     _display_ngs $width
  374.  
  375.     if [string compare [wm state .] withdrawn]==0 {
  376.         mapwindow
  377.     }
  378. }
  379.  
  380. # actually write all newsgroups to the window
  381. # PRIVATE
  382. proc _display_ngs {width} {
  383.     global db display_list
  384.  
  385.     set str_width [expr $width-7]
  386.  
  387.     .list delete 0 end
  388.     foreach ng $display_list {
  389.         .list insert end [format \
  390.             "%-$str_width.${str_width}s %5d" $ng \
  391.             [expr $db($ng,hi) - $db($ng,seen)]]
  392.     }
  393. }
  394.  
  395. # PUBLIC
  396. proc help {} {
  397.     catch {destroy .help}
  398.     toplevel .help
  399.     message .help.text -aspect 400 -text \
  400. {tknewsbiff - written by Don Libes, NIST, 1/1/94
  401.  
  402. tknewsbiff displays newsgroups with unread articles based on your .newsrc\
  403. and your .tknewsbiff files.\
  404. If no articles are unread, no window is displayed.
  405.  
  406. Click mouse button 1 for this help,\
  407. button 2 to force display to query news server immediately,\
  408. and button 3 to remove window from screen until the next update.
  409.  
  410. Example .tknewsbiff file:}
  411.     message .help.sample -font "*-r-normal-*-m-*" \
  412.     -relief raised -aspect 10000 -text \
  413. {set width    30        ;# max width, defaults to 27
  414. set height    17        ;# max height, defaults to 10
  415. set delay    120        ;# in seconds, defaults to 60
  416. set server    news.nist.gov    ;# defaults to "news"
  417. set server_timeout 60        ;# in seconds, defaults to 60
  418. set newsrc    ~/.newsrc    ;# defaults to ~/.newsrc
  419.                 ;# after trying ~/.newsrc-$server
  420. # Groups to watch.
  421. watch comp.lang.tcl
  422. watch dc.dining        -new "play yumyum"
  423. watch nist.security    -new "exec red-alert"
  424. watch nist.*
  425. watch dc.general    -threshold 5
  426. watch *.sources.*    -threshold 20
  427. watch alt.howard-stern    -threshold 100 -new "play robin"
  428.  
  429. # Groups to ignore (but which match patterns above).
  430. # Note: newsgroups that you don't read are ignored automatically.
  431. ignore *.d
  432. ignore nist.security
  433. ignore nist.sport
  434.  
  435. # Change background color of newsgroup list
  436. .list config -bg honeydew1
  437.  
  438. # Play a sound file
  439. proc play {sound} {
  440.     exec play /usr/local/lib/sounds/$sound.au
  441. }}
  442.     message .help.end -aspect 10000 -text \
  443. "Other customizations are possible.  See man page for more information."
  444.  
  445.     button .help.ok -text "ok" -command {destroy .help}
  446.     pack .help.text
  447.     pack .help.sample
  448.     pack .help.end -anchor w
  449.     pack .help.ok -fill x -padx 2 -pady 2
  450. }
  451.  
  452. spawn cat -u; set _cat_spawn_id $spawn_id
  453. set _update_flag 0
  454.  
  455. # PUBLIC
  456. proc update-now {} {
  457.     global _update_flag _cat_spawn_id
  458.  
  459.     if $_update_flag return    ;# already set, do nothing
  460.     set _update_flag 1
  461.  
  462.     exp_send -i $_cat_spawn_id "\r"
  463. }
  464.  
  465. bind .list <1> help
  466. bind .list <2> update-now
  467. bind .list <3> unmapwindow
  468. bind .list <Configure> {
  469.     scan [wm geometry .] "%%dx%%d" w h
  470.     _display_ngs $w
  471. }
  472.  
  473. # PRIVATE
  474. proc _sleep {timeout} {    
  475.     global _cat_spawn_id _update_flag
  476.  
  477.     set _update_flag 0
  478.  
  479.     # restore to idle cursor
  480.     .list config -cursor ""; update
  481.  
  482.     # sleep for a little while, subject to click from "update" button
  483.     expect -i $_cat_spawn_id -re "...."    ;# two crlfs
  484.  
  485.     # change to busy cursor
  486.     .list config -cursor watch; update
  487. }
  488.  
  489. set previous_seen_list {}
  490. set seen_list {}
  491.  
  492. # PRIVATE
  493. proc _init_ngs {} {
  494.     global display_list db
  495.     global seen_list previous_seen_list
  496.  
  497.     set previous_seen_list $seen_list
  498.  
  499.     set display_list {}
  500.     set seen_list {}
  501.  
  502.     catch {unset db}
  503. }
  504.  
  505. for {} 1 {_sleep $delay} {
  506.     _init_ngs
  507.  
  508.     _read_newsrc
  509.     if [_read_active] continue
  510.     _read_config_file
  511.  
  512.     _update_ngs
  513.     user
  514.     _update_window
  515. }
  516.